Option Strict Off
Option Explicit On
Module MODweb
	' Public variables ---------------------------------------------------------------------------------------------
	
	Public initSQLStr, finalSQLStr As String
	
	Public isNewRecord, bUpdatedFromFile As Boolean
	
	'Objects -------------------------------------------------------------------------------------------------------
	
	Private fso As Scripting.FileSystemObject
	Private oSQL As Scripting.TextStream
	Private oLog As Scripting.TextStream
	Private oCLS_IE As CLS_IE
	
	' User defined objects ---------------------------------------------------------------------------------------------------
	
	Private Structure SQLstatementList
		Dim uniqueID As String
		Dim SQLstatement As String
	End Structure
	
	Private statementArray() As SQLstatementList
	
	Private iArrayLength As Short
	
	' Constants -------------------------------------------------------------------------------------------------------------------------------
	
	Private Const sUPDATE_DIR_NAME As String = "update"
	
	' Booleans --------------------------------------------------------------------------------------------------------------------------------
	
	Private bFatalError As Boolean
	
	' Strings -------------------------------------------------------------------------------------------------------------------------------
	
	Private sActionOnError, SQLclause, statementListString As String
	
	' Init Web Module ---------------------------------------------------------------------------------------------------------------------
	
	Public Sub init()
		
		resetStatementArray()
		
	End Sub
	
	Public Sub updateAllRecords(Optional ByRef sSQLin As String = "")
		
		On Error Resume Next
		
		logMessage(iDEBUG, "Web", "updateAllRecords method called ")
		
		Dim sPostData, sSQL, sTableName, sURL As String
		
		If sSQLin = "" Then
			
			If iArrayLength < 1 Then ' In case there are no items in the SQLstatement list
				
				MsgBox("There are no edited records to update")
				
				Exit Sub
				
			End If
			
			'UPGRADE_WARNING: Couldn't resolve default property of object buildStatementListString. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
			sSQL = buildStatementListString
			
			logMessage(iDEBUG, "Web", "buildStatementListString method called ", "Sql = " & sSQL)
			
		Else
			
			sSQL = sSQLin
			
		End If
		
		' Show modal 'updating' dialog --------------------------------------------------------------------------------
		
		If IsNumeric(FRMmain.LISTtables.SelectedIndex) And FRMmain.LISTtables.SelectedIndex > -1 Then
			
			sTableName = VB6.GetItemString(FRMmain.LISTtables, FRMmain.LISTtables.SelectedIndex)
			
		Else
			
			sTableName = "components"
			
		End If
		
		sPostData = "SQLstatementList=" & sSQL
		
		sPostData = Replace(sPostData, " ", "%20")
		sPostData = Replace(sPostData, "&", "%26")
		sPostData = sPostData & "&action=multipleUpdate"
		sPostData = sPostData & "&tableName=" & sTableName
		
		'UPGRADE_WARNING: Couldn't resolve default property of object getPref(remoteDB, updatePagePath). Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		'UPGRADE_WARNING: Couldn't resolve default property of object getPref(). Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		sURL = getPref("remoteDB", "serverAddress") & "/" & getPref("remoteDB", "updatePagePath")
		
		' Send data to web browser for update -------------------------------------------------------------------------------------------
		
		oCLS_IE = New CLS_IE
		
		oCLS_IE.updateWithBrowser(sURL, sPostData)
		
		FRMmain.bRemoteSaved = True
		
	End Sub
	
	Public Function getPostData(ByRef sData As String) As Object
		
		On Error Resume Next
		
		Dim aBuffer() As Byte
		Dim sBuffer As String
		
		sBuffer = sData
		
		aBuffer = System.Text.UnicodeEncoding.Unicode.GetBytes(sBuffer)
		
		'UPGRADE_WARNING: Couldn't resolve default property of object getPostData. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		getPostData = VB6.CopyArray(aBuffer)
		
	End Function
	
	Public Function buildStatementListString() As Object
		Dim i As Object
		
		On Error Resume Next
		
		statementListString = ""
		
		For i = 0 To iArrayLength - 1
			'UPGRADE_WARNING: Couldn't resolve default property of object i. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
			statementListString = statementListString & statementArray(i).uniqueID & ";;" & statementArray(i).SQLstatement & "||"
		Next 
		
		' Remove the last two 'pipes' ------------------------------------------------------------------------------------------------
		
		buildStatementListString = Left(statementListString, Len(statementListString) - 2)
		
	End Function
	
	
	Public Sub addSQLlistItem(ByRef uniqueID As String, ByRef SQLstatement As String)
		Dim i As Object
		
		On Error Resume Next
		
		' If the unique ID exists in the array, then replace its SQL statement with the new one, unless the existing SQLstatment operation is 'INSERT INTO' ---------------------------------------------
		
		For i = 1 To iArrayLength
			
			'UPGRADE_WARNING: Couldn't resolve default property of object i. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
			If statementArray(i - 1).uniqueID = uniqueID And UCase(Left(statementArray(i - 1).SQLstatement, 11)) <> "INSERT INTO" Then
				
				'UPGRADE_WARNING: Couldn't resolve default property of object i. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
				statementArray(i - 1).SQLstatement = SQLstatement
				
				Exit Sub
				
			End If
			
		Next 
		
		ReDim Preserve statementArray(iArrayLength)
		
		statementArray(iArrayLength).uniqueID = uniqueID
		statementArray(iArrayLength).SQLstatement = SQLstatement
		
		iArrayLength = iArrayLength + 1
		
		FRMmain.WebUpdateAllRecords.Enabled = True
		FRMmain.WebUpdateLater.Enabled = True
		FRMmain.editUpdateRow.Enabled = True
		
	End Sub
	
	Public Sub resetStatementArray()
		
		ReDim statementArray(0)
		iArrayLength = 0
		
	End Sub
	
	Public Function buildUpdateStatement(ByRef objRecordset As ADODB.Recordset, ByRef clause As String) As Object
		Dim sFieldValues As Object
		Dim sFieldNames As Object
		Dim i As Object
		Dim remoteDBfieldNamesArray As Object
		Dim remoteDBfieldNames As Object
		
		On Error Resume Next
		
		' ths variable is checked before the user exits to make sure he updated the remote database
		' or saved the list of records to update.
		' It is set to true, if the database is updated, or if the records are saved
		
		FRMmain.bRemoteSaved = False
		
		SQLclause = clause
		
		If objRecordset.EOF Then Exit Function
		
		'UPGRADE_WARNING: Couldn't resolve default property of object MODpreferences.getPref(). Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		'UPGRADE_WARNING: Couldn't resolve default property of object remoteDBfieldNames. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		remoteDBfieldNames = MODpreferences.getPref("remoteDB", "fieldNames")
		
		'UPGRADE_WARNING: Couldn't resolve default property of object remoteDBfieldNames. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		'UPGRADE_WARNING: Couldn't resolve default property of object remoteDBfieldNamesArray. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		remoteDBfieldNamesArray = Split(remoteDBfieldNames, ",")
		
		Select Case clause
			Case "WHERE"
				initSQLStr = " WHERE [uniqueID] = '" & objRecordset.Fields("uniqueID").Value & "'"
				
				'            For i = 1 To UBound(remoteDBfieldNamesArray) - 1
				'                initSQLStr = initSQLStr & " AND [" & remoteDBfieldNamesArray(i) & "] = '" & _
				''                    objRecordset(remoteDBfieldNamesArray(i)) & "'"
				'            Next
				
			Case "SET"
				'UPGRADE_WARNING: Couldn't resolve default property of object remoteDBfieldNamesArray(0). Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
				finalSQLStr = "UPDATE " & VB6.GetItemString(FRMmain.LISTtables, FRMmain.LISTtables.SelectedIndex) & "" & " SET [" & remoteDBfieldNamesArray(0) & "] = '" & objRecordset.Fields(remoteDBfieldNamesArray(0)).Value & "'"
				
				For i = 1 To UBound(remoteDBfieldNamesArray)
					'UPGRADE_WARNING: Couldn't resolve default property of object remoteDBfieldNamesArray(). Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
					finalSQLStr = finalSQLStr & " , [" & remoteDBfieldNamesArray(i) & "] = '" & objRecordset.Fields(remoteDBfieldNamesArray(i)).Value & "'"
				Next 
				
				finalSQLStr = finalSQLStr & initSQLStr
				
				addSQLlistItem(objRecordset.Fields("uniqueID").Value, finalSQLStr)
				
			Case "INSERT"
				
				For i = 0 To UBound(remoteDBfieldNamesArray)
					'UPGRADE_WARNING: Couldn't resolve default property of object remoteDBfieldNamesArray(). Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
					'UPGRADE_WARNING: Couldn't resolve default property of object sFieldNames. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
					sFieldNames = sFieldNames & remoteDBfieldNamesArray(i) & ","
				Next 
				
				'UPGRADE_WARNING: Couldn't resolve default property of object sFieldNames. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
				sFieldNames = Left(sFieldNames, Len(sFieldNames) - 1)
				
				For i = 0 To UBound(remoteDBfieldNamesArray)
					'UPGRADE_WARNING: Couldn't resolve default property of object sFieldValues. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
					sFieldValues = sFieldValues & "'" & objRecordset.Fields(remoteDBfieldNamesArray(i)).Value & "',"
				Next 
				
				'UPGRADE_WARNING: Couldn't resolve default property of object sFieldValues. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
				sFieldValues = Left(sFieldValues, Len(sFieldValues) - 1)
				
				'UPGRADE_WARNING: Couldn't resolve default property of object sFieldValues. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
				'UPGRADE_WARNING: Couldn't resolve default property of object sFieldNames. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
				finalSQLStr = "INSERT INTO " & VB6.GetItemString(FRMmain.LISTtables, FRMmain.LISTtables.SelectedIndex) & " ( " & sFieldNames & " ) VALUES ( " & sFieldValues & " ) "
				
				'------------------------------------------------------------------------------
				' Only check the autoUpdate preference if it is a new record,
				' because if it is not a new row then the user must choose to
				' update the remote record manually by pressing "OK" on the confirm dialog
				'------------------------------------------------------------------------------
				
				If isNewRecord Then
					
					addSQLlistItem(objRecordset.Fields("uniqueID").Value, finalSQLStr)
					
					' Records are automatically updated after insertion because otherwise once the user edits the new row, the statement will be built with a 'WHERE' clause
					
					'updateAllRecords
					
				End If
				
			Case "DELETE"
				finalSQLStr = "DELETE * FROM " & VB6.GetItemString(FRMmain.LISTtables, FRMmain.LISTtables.SelectedIndex) & " WHERE " & "uniqueID = '" & objRecordset.Fields("uniqueID").Value & "'"
				
				addSQLlistItem(objRecordset.Fields("uniqueID").Value, finalSQLStr)
				
		End Select
		
		
	End Function
	
	' Update remote database with SQL staments that were written to a text file -------------------------------------------------------------
	
	Public Sub updateFromFile()
		
		On Error Resume Next
		
		bUpdatedFromFile = True
		
		Dim sSQL As String
		
		fso = New Scripting.FileSystemObject
		
		If Not fso.FileExists(MODweb.sRemoteUpdateRecordsFilePath) Then
			
			MsgBox("There is no file to read from")
			
			Exit Sub
			
		End If
		
		On Error Resume Next
		
		oSQL = fso.OpenTextFile(MODweb.sRemoteUpdateRecordsFilePath, Scripting.IOMode.ForReading, False)
		
		If Err.Number <> 0 Then
			
			MsgBox("Could not open records file for updating." & vbCrLf & "Reason : " & Err.Description)
			
			logMessage(iERROR, "Web", "Could not open text file for reading records for update",  , Err.Number, Err.Description)
			
			Exit Sub
			
		Else
			
			logMessage(iINFO, "Web", "Opened text file for reading records for update")
			
		End If
		
		On Error Resume Next
		
		sSQL = oSQL.ReadAll
		
		If Err.Number <> 0 Then
			
			MsgBox("Could not read records file for updating." & vbCrLf & "Reason : " & Err.Description)
			
			logMessage(iERROR, "Web", "Could not read text file for update",  , Err.Number, Err.Description)
			
			Exit Sub
			
		Else
			
			logMessage(iINFO, "Web", "Read text file for update", "SQL = " & sSQL)
			
		End If
		
		sSQL = Replace(sSQL, vbCrLf, "||")
		
		' check for extra pipes and remove them -------------------------------------------------------------------------------
		
		If Right(sSQL, 2) = "||" Then sSQL = Left(sSQL, Len(sSQL) - 2)
		
		If Trim(sSQL) = "" Then
			
			MsgBox("File is empty")
			
			Exit Sub
			
		End If
		
		
		oSQL.Close()
		
		updateAllRecords(sSQL)
		
	End Sub
	
	' Write SQl statements to a text file so the user can update the remote database at a later time --------------------------------------------------------
	
	Public Sub exportRecordsForUpdate()
		
		On Error Resume Next
		
		Dim sSQL As String
		
		If iArrayLength = 0 Then ' In case there are no items in the SQLstatement list
			
			MsgBox("There are no edited records to update")
			
			Exit Sub
			
		End If
		
		'UPGRADE_WARNING: Couldn't resolve default property of object buildStatementListString. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6A50421D-15FE-4896-8A1B-2EC21E9037B2"'
		sSQL = buildStatementListString
		
		sSQL = Replace(sSQL, "||", vbCrLf)
		
		If Trim(sSQL) = "" Then
			
			MsgBox("Could not save records for updating")
			
			Exit Sub
			
		End If
		
		fso = New Scripting.FileSystemObject
		
		If Not fso.FolderExists(sRemoteUpdateDirPath) Then fso.CreateFolder(sRemoteUpdateDirPath)
		
		On Error Resume Next
		
		oSQL = fso.OpenTextFile(MODweb.sRemoteUpdateRecordsFilePath, Scripting.IOMode.ForAppending, True)
		
		If Err.Number <> 0 Then
			
			MsgBox("Could not open records file for saving." & vbCrLf & "Reason : " & Err.Description)
			
			logMessage(iERROR, "Web", "Could not open text file for saving records for update",  , Err.Number, Err.Description)
			
			Exit Sub
			
		Else
			
			logMessage(iINFO, "Web", "Opened text file for saving records for update")
			
		End If
		
		' Write SQL statements to text file ----------------------------------------------------------------------------------------------
		
		On Error Resume Next
		
		oSQL.Write(sSQL & vbCrLf)
		
		If Err.Number <> 0 Then
			
			MsgBox("Could not write to save file." & vbCrLf & "Reason : " & Err.Description)
			
			logMessage(iERROR, "Web", "Could not write to text file for saving records", "SQL = " & sSQL, Err.Number, Err.Description)
			
			Exit Sub
			
		Else
			
			logMessage(iINFO, "Web", "Wrote records to text file for saving", "SQL = " & sSQL)
			
		End If
		
		oSQL.Close()
		
		'UPGRADE_NOTE: Object oSQL may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
		oSQL = Nothing
		
		'UPGRADE_NOTE: Object fso may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6E35BFF6-CD74-4B09-9689-3E1A43DF8969"'
		fso = Nothing
		
		FRMmain.bRemoteSaved = True
		
		resetStatementArray()
		
		MsgBox("Records saved")
		
	End Sub
	
	Public ReadOnly Property sRemoteUpdateDirPath() As String
		Get
			
			sRemoteUpdateDirPath = My.Application.Info.DirectoryPath & "/" & sUPDATE_DIR_NAME & "/"
			
		End Get
	End Property
	
	Public ReadOnly Property sRemoteUpdateRecordsFilePath() As String
		Get
			
			sRemoteUpdateRecordsFilePath = My.Application.Info.DirectoryPath & "/" & sUPDATE_DIR_NAME & "/webSQL.update"
			
		End Get
	End Property
	
	Public ReadOnly Property sRemoteUpdateBackupDirPath() As String
		Get
			
			sRemoteUpdateBackupDirPath = My.Application.Info.DirectoryPath & "/" & sUPDATE_DIR_NAME & "/" & "backup" & "/"
			
		End Get
	End Property
End Module